home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / GRAPTIES / SD204.LZH / ADDRESS.PAS < prev    next >
Pascal/Delphi Source File  |  1980-01-01  |  13KB  |  373 lines
  1. PROGRAM Address;
  2. {=================================================================}
  3. { This program is a simple address list manager that shows how to }
  4. { use BOX screens effectively in three differerent ways:          }
  5. {                                                                 }
  6. {     Logo screens -- the Logo screen was created using BOX       }
  7. {                                                                 }
  8. {     Help screens -- Context sensitive help screens were created }
  9. {                     using BOX and are displayed when requested  }
  10. {                     by a special keystroke intercept routine    }
  11. {                     that watches each keystroke for F1.         }
  12. {                                                                 }
  13. {     Data screens -- The data entry screen used for the          }
  14. {                     entry of address was created by BOX and     }
  15. {                     displayed by the routines in LOADFILE       }
  16. {                                                                 }
  17.  
  18. USES IOSTUFF,LOADFILE,MENUBOX,GETLNE,KEY2,CRT;
  19.  
  20. { Source code for the Units above are included on the BOX disk.   }
  21. { These Units are part of the Turbo Overdrive Package (TOP),      }
  22. { a collection of useful subroutines from Nescatunga Software.    }
  23. { If you register for TOP ($20) you will recieve the entire TOP   }
  24. { collection of over 40 subroutines along with complete           }
  25. { documentation.  TOP includes pulldown menus, a popup calculator }
  26. { point and shoot file selector and much more.                    }
  27.  
  28. TYPE
  29.  
  30.   Rec = Record                      { Address Record }
  31.           Name      : String[30];
  32.           Street    : String[20];
  33.           Town      : String[20];
  34.           State     : String[2];
  35.           Zip       : String[7];
  36.           Notes1    : String[43];
  37.           Notes2    : String[43];
  38.         End;
  39.  
  40.   RecFile = File of Rec;
  41.  
  42.  
  43. VAR
  44.     FilevarM   : File;        { File of addresses }
  45.     Addr       : Array[1..100] of Rec; { Array of address records }
  46.     NumRec     : Integer;     { Number of records }
  47.     CurIndx    : Integer;     { Index of current record }
  48.     II         : Integer;     { Misc. looping index }
  49.     Escaped    : Boolean;     { True if user hit Esc. in SelectRec }
  50.     BigExit    : Boolean;     { Exit switch       }
  51.     Ch         : Char;        { Input character   }
  52.     HoldRec    : Rec;         { A temporary holding record }
  53. {=================================================================}
  54. PROCEDURE BlankFields;
  55.  
  56. { Blanks out the fields on the screen                             }
  57.  
  58. BEGIN
  59.     WriteSt('                              ',22,11);
  60.     WriteSt('                    ',22,13);
  61.     WriteSt('                    ',22,15);
  62.     WriteSt('  ',50,15);
  63.     WriteSt('       ',58,15);
  64.     WriteSt('                                           ',22,17);
  65.     WriteSt('                                           ',22,19);
  66. END;
  67.  
  68. {=================================================================}
  69. PROCEDURE ShowRec(NewRec : Rec);
  70.  
  71. { Displays the contents of Address record NewRec on the Screen }
  72.  
  73. BEGIN
  74.   BlankFields;
  75.   With NewRec do
  76.   Begin
  77.     WriteSt(Name,22,11);
  78.     WriteSt(Street,22,13);
  79.     WriteSt(Town,22,15);
  80.     WriteSt(State,50,15);
  81.     WriteSt(Zip,58,15);
  82.     WriteSt(Notes1,22,17);
  83.     WriteSt(Notes2,22,19);
  84.   end;
  85. END;
  86.  
  87. {=========================================================}
  88. PROCEDURE GetNewRec(VAR NewRec : Rec);
  89.  
  90. { Accepts input for each of the fields in the record }
  91.  
  92. BEGIN
  93.     BlankFields;       { Blank the displayed record on screen }
  94.     With NewRec do
  95.     Begin
  96.        Name      := GetStr(22,11,30,'');
  97.        Street    := GetStr(22,13,20,'');
  98.        Town      := GetStr(22,15,20,'');
  99.        State     := GetStr(50,15,2,'');
  100.        Zip       := GetStr(58,15,7,'');
  101.        Notes1    := GetStr(22,17,43,'');
  102.        Notes2    := GetStr(22,19,43,'');
  103.    end;
  104.  
  105. END;
  106.  
  107. {=========================================================}
  108. PROCEDURE GetExistRec(VAR NewRec : Rec; OldRec : Rec);
  109.  
  110. { Accepts input for each of the fields in the record              }
  111.  
  112. BEGIN
  113.     ShowRec(OldRec);  { Show the old Record as a default }
  114.     With NewRec do
  115.     Begin
  116.        Name      := GetStr(22,11,30,OldRec.Name);
  117.        Street    := GetStr(22,13,20,OldRec.Street);
  118.        Town      := GetStr(22,15,20,OldRec.Town);
  119.        State     := GetStr(50,15,2,OldRec.State);
  120.        Zip       := GetStr(58,15,7,OldRec.Zip);
  121.        Notes1    := GetStr(22,17,43,OldRec.Notes1);
  122.        Notes2    := GetStr(22,19,43,OldRec.Notes2);
  123.    end;
  124.  
  125. END;
  126.  
  127. {=========================================================}
  128. FUNCTION InsertLoc(RecNow : Rec) : Integer;
  129.  
  130. { Finds the location to insert record RecNow }
  131.  
  132. VAR
  133.   Located : Boolean;
  134.   Indx    : Integer;
  135.  
  136. BEGIN
  137.   If NumRec = 0 then Indx := 1   { Handle case of no records }
  138.   Else
  139.   Begin
  140.     Located := False;
  141.     Indx := 0;
  142.     Repeat         { Search through records to find insert location }
  143.       Inc(Indx);
  144.       If (Addr[Indx].Name > RecNow.Name) then Located := True;
  145.     Until Located or (Indx = NumRec);
  146.     If not Located then Indx := NumRec + 1;
  147.   End;
  148.   InsertLoc := Indx;
  149. END;
  150.  
  151. {=========================================================}
  152. PROCEDURE InsertRec (RecNow : Rec; Indx : Integer);
  153.  
  154. { Inserts record RecNow at location Indx }
  155. VAR
  156.   II : Integer;
  157. BEGIN
  158.   If NumRec + 1 < 100 then    { Don't exceed array size }
  159.   Begin
  160.     Inc(NumRec);
  161.     If Indx < NumRec then     { First push the array up }
  162.     For II := NumRec downto Indx do Addr[II] := Addr[II-1];
  163.     Addr[Indx] := RecNow;     { Then insert the new record }
  164.   End
  165.   Else Display('Error -- Too many address records',1,25);
  166. END;
  167.  
  168. {=================================================================}
  169. PROCEDURE ReadFile;
  170.  
  171. { Load the address file and builds the address array. }
  172.  
  173. VAR
  174.    WorkFile : RecFile;
  175.  
  176. BEGIN
  177.   NumRec := 0;
  178.   Assign(WorkFile,'ADDRESS.DAT');
  179.   {$I-} Reset(WorkFile); {$I+}
  180.   If IOResult = 0 then
  181.   Begin
  182.     While Not eof (WorkFile) do
  183.       Begin
  184.         Inc(NumRec);                 { Read into the array }
  185.         Read(WorkFile,Addr[NumRec]);
  186.       End;
  187.     Close(WorkFile);
  188.     Display('Address file loaded',1,25);
  189.   End;
  190. END;
  191.  
  192. {=================================================================}
  193. PROCEDURE WriteFile;
  194.  
  195. { Saves the address file to disk. }
  196.  
  197. VAR
  198.    WorkFile : RecFile;
  199.    II       : Integer;
  200. BEGIN
  201.   Assign(WorkFile,'ADDRESS.DAT');
  202.   ReWrite(WorkFile);
  203.   If NumRec > 0 then
  204.     For II := 1 to NumRec do Write(WorkFile,Addr[II]);
  205.   Close(WorkFile);
  206.   Display('Address file saved',1,25);
  207. END;
  208.  
  209. {=================================================================}
  210. PROCEDURE SelectRec(VAR Indx : Integer;VAR Escaped : Boolean);
  211.  
  212. { Allows the user to browse the list.  The selected record        }
  213. { is returned in Indx.                                        }
  214.  
  215. VAR
  216.    VCh        : Char;
  217.    SelectExit : Boolean;
  218.  
  219. BEGIN
  220.  
  221.  If NumRec = 0 then Display('The Address List is empty',1,25)
  222.  Else
  223.  Begin
  224.    If (Indx < 1) or (Indx > NumRec) then Indx := 1;
  225.    SelectExit := False;
  226.    Repeat                      { Big record browse loop }
  227.       ShowRec(Addr[Indx]);
  228.       If Indx = 1 then WriteSt(Chr(25)+' ',50,25)
  229.       Else If Indx = NumRec then WriteSt(' '+Chr(24),50,25)
  230.       Else WriteSt(Chr(25)+Chr(24),50,25);
  231.       VCh := NextKey;            { NextKey is a special key reading routine }
  232.                                  { that watches for the help key (F1) and   }
  233.                                  { displays the help screen depending on    }
  234.                                  { the current value of HelpEnv.            }
  235.       If Not FunctKey Then
  236.       Case VCh of
  237.         #13 : Begin              { Enter Key }
  238.                Escaped := False;
  239.                SelectExit := True;
  240.               End;
  241.         #27 : Begin              { Escape Key }
  242.                Escaped := True;
  243.                SelectExit := True;
  244.               End;
  245.  
  246.          Else Beep;
  247.       End; {Case}
  248.  
  249.       If (FunctKey) then
  250.       Case VCh  of
  251.         #80,#81 :Begin          { Down arrow & PgDn }
  252.                    If Indx < NumRec
  253.                       then Inc(Indx)
  254.                    Else Beep;
  255.                  End;
  256.        #72,#73 :Begin           { Up arrow and PgUp }
  257.                   If Indx > 1
  258.                     then Dec(Indx)
  259.                   Else Beep;
  260.                 End;
  261.         Else Beep;
  262.       End {Case}
  263.     Until SelectExit;          { End of browse loop }
  264.     Display('',1,25);
  265.   End;
  266.  END;
  267.  
  268. {=================================================================}
  269.  
  270. { Main program.                                                   }
  271.  
  272. BEGIN
  273.  BigExit := false;
  274.  Load_Mem('ADDRESS.LGO');            { Show the BOX logo screen  }
  275.  Display('Loading Help Files',1,25);
  276.  
  277.  SetHelpMax(4);                       { Set number of help screens }
  278.  HelpLoad(1,'ADDRESS.1');            { Load the BOX help screens  }
  279.  HelpLoad(2,'ADDRESS.2');
  280.  HelpLoad(3,'ADDRESS.3');
  281.  HelpLoad(4,'ADDRESS.4');
  282.  HelpEnv := 1;                        { Set the help environment   }
  283.  
  284.  Wait;                                { Wait for a keystroke }
  285.  Load_Mem('ADDRESS.SCR');            { Show the BOX data entry screen }
  286.  
  287.  CurIndx := 1;
  288.  NumRec := 0;
  289.  ReadFile;                            { Load the address file      }
  290.  If NumRec > 0 then ShowRec(Addr[CurIndx]);
  291.  
  292.  SetMenuBox(12,1,'ADDRESS MANAGER',    { Set up the menu }
  293.                  'Browse Addresses@'+
  294.                  'Add New Address@'+
  295.                  'Change Address@'+
  296.                  'Delete Address@'+
  297.                  'Save Address File@'+
  298.                  'Quit@');
  299.  
  300.  Repeat Case PickMenuBox of          { Start the big menu loop }
  301.  
  302.    'B' : Begin                       { Browse }
  303.            If NumRec > 0 then
  304.            Begin
  305.              HelpEnv := 1;             { Set help environment to 1 }
  306.              Display('Use PgUp/PgDn to browse',1,25);
  307.              SelectRec(CurIndx,Escaped);
  308.            End;
  309.          End;
  310.  
  311.    'A' : Begin                       { Add }
  312.            HelpEnv := 2;             { Set help environment to 2 }
  313.            Repeat
  314.              Display('',1,25);
  315.              GetNewRec(HoldRec);    { Let user input the record }
  316.              If Yes('Add Record Above? (Y or N)') then
  317.              Begin
  318.                CurIndx := InsertLoc(HoldRec);
  319.                InsertRec(HoldRec, CurIndx);
  320.              End;
  321.            Until not Yes('Add Another Record? (Y or N)');
  322.            Display('',1,25);
  323.          End;
  324.  
  325.    'C' : Begin                       { Change }
  326.            If NumRec > 0 then
  327.            Begin
  328.              HelpEnv := 3;             { Set help environment to 3 }
  329.              Display('Use PgUp/PgDn to select then hit enter to change',1,25);
  330.              SelectRec(CurIndx,Escaped);      { Select a record }
  331.              If not Escaped then
  332.  
  333.                Begin
  334.                    GetExistRec(HoldRec,Addr[CurIndx]);
  335.                    If Yes('Save Changed Record Above? (Y or N)') then
  336.                    Begin
  337.                      For II := CurIndx to NumRec-1 do Addr[II] := Addr[II+1];
  338.                      Dec(NumRec);
  339.                      CurIndx := InsertLoc(HoldRec);
  340.                      InsertRec(HoldRec, CurIndx);
  341.                    End;
  342.               End;   { not escaped }
  343.             End;     { NumRec > 0 }
  344.           End;
  345.  
  346.    'D' : Begin                    { Delete }
  347.            If NumRec > 0 then
  348.            Begin
  349.              HelpEnv := 4;          { Set help environment to 4 }
  350.              Display('Use PgUp/PgDn to select then hit enter to delete',1,25);
  351.              SelectRec(CurIndx,Escaped);                        { Select a record }
  352.              If not Escaped then
  353.              Begin
  354.                For II := CurIndx to NumRec do Addr[II] := Addr[II+1];
  355.                Dec(NumRec);
  356.              End;
  357.              CurIndx := 1;
  358.              ShowRec(Addr[CurIndx]);
  359.            End;
  360.          End;
  361.  
  362.    'S' : WriteFile;               { Save }
  363.  
  364.    #0,'Q' : BigExit := True;      { Quit (note that esc. returns #0)}
  365.  
  366.    End;               { of case pickmenubox }
  367.    ResetBox;          { rebuild the menu }
  368.    HelpEnv := 1;      { Set help environment back to 1 (general help) }
  369.    Display('',1,25);  { blank the bottom line of the screen }
  370.   Until BigExit;
  371. END.                  { That's all }
  372.  
  373.